home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / efs / efs-coke.el.z / efs-coke.el
Encoding:
Text File  |  1998-05-21  |  5.8 KB  |  177 lines
  1. ;; -*-Emacs-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;;
  4. ;; File:         efs-coke.el
  5. ;; Release:      $efs release: 1.15 $
  6. ;; Version:      #Revision: 1.1 $
  7. ;; RCS:          
  8. ;; Description:  Coke Machine support for efs
  9. ;; Author:       Sandy Rutherford <sandy@imb550.sissa.it>
  10. ;; Created:      Fri Oct 14 23:55:04 1994 by sandy on ibm550
  11. ;; Modified:     Sun Nov 27 12:16:47 1994 by sandy on gandalf
  12. ;; Language:     Emacs-Lisp
  13. ;;
  14. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  15.  
  16. ;;; This file is part of efs. See efs.el for copyright
  17. ;;; (it's copylefted) and warrranty (there isn't one) information.
  18.  
  19. (provide 'efs-coke)
  20. (require 'efs)
  21.  
  22. (defconst efs-coke-version
  23.   (concat (substring "$efs release: 1.15 $" 14 -2)
  24.       "/"
  25.       (substring "#Revision: 1.1 $" 11 -2)))
  26.  
  27. ;;;; ------------------------------------------------------------
  28. ;;;; Coke Machine support
  29. ;;;; ------------------------------------------------------------
  30. ;;;
  31. ;;;  Works for the MIT vending machine FTP server.
  32. ;;;  Hopefully, a vending machine RFC is on its way, so we won't
  33. ;;;  need to support a wide variation of vending machine protocols.
  34.  
  35. (efs-defun efs-send-pwd coke (host user &optional xpwd)
  36.   ;; Directories on vending machines?
  37.   "/")
  38.  
  39. (efs-defun efs-fix-path coke (path &optional reverse)
  40.   (if (= ?/ (aref path 0))
  41.       (if reverse path (substring path 1))
  42.     (if reverse (concat "/" path) path)))
  43.  
  44. (efs-defun efs-fix-dir-path coke (dir-path)
  45.   ;; Make a beverage path for a dir listing.
  46.   (if (or (string-equal dir-path "/") (string-equal dir-path "/."))
  47.       "*"
  48.     dir-path))
  49.  
  50. (efs-defun efs-parse-listing coke
  51.   (host user dir path &optional switches)
  52.   ;; Parse the current buffer which is assumed to be in coke machine
  53.   ;; ftp dir format.
  54.   ;; HOST = remote host name
  55.   ;; USER = remote user name
  56.   ;; DIR = remote directory as a remote full path
  57.   ;; PATH = directory as an efs full path
  58.   ;; SWITCHES are never used here, but they
  59.   ;; must be specified in the argument list for compatibility
  60.   ;; with the unix version of this function.
  61.   (let ((tbl (efs-make-hashtable)))
  62.     (goto-char (point-min))
  63.     (efs-save-match-data
  64.       (while (re-search-forward "^\\(SOLD OUT \\)?\\[[0-9]+\\] +\\([^:\n]+\\)"
  65.                 nil t)
  66.     (efs-put-hash-entry (buffer-substring (match-beginning 2)
  67.                           (match-end 2))
  68.                 (list nil) tbl)
  69.     (forward-line 1)))
  70.     ;; Don't need to bother with ..
  71.     (efs-put-hash-entry "." '(t) tbl)
  72.     tbl))
  73.  
  74. (efs-defun efs-allow-child-lookup coke (host user dir file)
  75.   ;; Returns t if FILE in directory DIR could possibly be a subdir
  76.   ;; according to its file-name syntax, and therefore a child listing should
  77.   ;; be attempted.
  78.  
  79.   ;; Coke machine file system is flat.  Hopefully not the coke.
  80.   (and (string-equal "/" dir) (string-equal "." file)))
  81.  
  82. (defun efs-coke-insert-beverage-contents (buffer file line)
  83.   ;; Inserts the contents of a beverage (determined by the FTP server
  84.   ;; response LINE) into BUFFER, and then drinks it.
  85.   ;; FILE is the name of the file.
  86.   (efs-save-buffer-excursion
  87.     (set-buffer buffer)
  88.     (if (zerop (buffer-size))
  89.     (progn
  90.       (insert "\n\n\n\n      " (substring line 4) "\n")
  91.       (set-buffer-modified-p nil)
  92.       (set-process-sentinel
  93.        (start-process "efs-coke-gulp-buffer" (current-buffer) "sleep" "3")
  94.        (function
  95.         (lambda (proc str)
  96.           (efs-save-buffer-excursion
  97.         (let ((buff (process-buffer proc)))
  98.           (and buff (get-buffer buff)
  99.                (progn
  100.              (set-buffer buff)
  101.              (erase-buffer)
  102.              (insert "\n\n\n\n          GULP!!!\n")
  103.              (sit-for 1)
  104.              (set-buffer-modified-p nil)
  105.              (kill-buffer (current-buffer)))))))))
  106.       (if (featurep 'dired)
  107.           (dired-fun-in-all-buffers
  108.            (file-name-directory file) 'dired-revert)))
  109.       (message "You haven't finished your last drink in buffer %s!"
  110.            (current-buffer))
  111.       (ding)
  112.       (sit-for 1))))
  113.  
  114. ;;; Dired support
  115.  
  116. (efs-defun efs-dired-manual-move-to-filename coke
  117.   (&optional raise-error bol eol)
  118.   ;; In dired, move to first char of filename on this line.
  119.   ;; Returns position (point) or nil if no filename on this line.
  120.   ;; This is the COKE version.
  121.   (or eol (setq eol (save-excursion (skip-chars-forward "^\n\r") (point))))
  122.   (if bol
  123.       (goto-char bol)
  124.     (skip-chars-backward "^\n\r")
  125.     (setq bol (point)))
  126.   (if (looking-at "\\(. \\)?\\(SOLD OUT \\)?\\[[0-9]+\\] +\\([^:\n]+\\): ")
  127.       (goto-char (match-beginning 3))
  128.     (and raise-error (error "No file on this line"))))
  129.  
  130. (efs-defun efs-dired-manual-move-to-end-of-filename coke
  131.   (&optional no-error bol eol)
  132.   ;; Assumes point is at beginning of filename.
  133.   ;; So, it should be called only after (dired-move-to-filename t).
  134.   ;; On failure, signals an error or returns nil.
  135.   ;; This is the COKE version.
  136.   (let ((opoint (point)))
  137.     (and selective-display
  138.      (null no-error)
  139.      (eq (char-after
  140.           (1- (or bol (save-excursion
  141.                 (skip-chars-backward "^\r\n")
  142.                 (point)))))
  143.          ?\r)
  144.      ;; File is hidden or omitted.
  145.      (cond
  146.       ((dired-subdir-hidden-p (dired-current-directory))
  147.        (error
  148.         (substitute-command-keys
  149.          "File line is hidden. Type \\[dired-hide-subdir] to unhide.")))
  150.       ((error
  151.         (substitute-command-keys
  152.          "File line is omitted. Type \\[dired-omit-toggle] to un-omit."
  153.          )))))
  154.     (if (search-forward ": " eol t)
  155.     (goto-char (- (match-end 0) 2))
  156.       (if no-error
  157.       nil
  158.     (error "No file on this line"))
  159.       (point))))
  160.  
  161. (efs-defun efs-dired-insert-headerline coke (dir)
  162.   (let* ((parsed (efs-ftp-path dir))
  163.      (host (car parsed))
  164.      (user (nth 1 parsed))
  165.      (accounting
  166.       (efs-send-cmd
  167.        host user '(quote pwd)
  168.        (format "Getting accounting data for %s@%s user host" user host))))
  169.     (insert "  " user "@" host "\n    "
  170.         (if (car accounting)
  171.         "Account status unavailable"
  172.           (substring (nth 1 accounting) 4)))
  173.     (delete-region (point) (progn (skip-chars-backward ":.,;") (point)))
  174.     (insert ":\n \n")))
  175.  
  176. ;;; end of efs-coke.el
  177.